home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Getopt / Std.pm < prev   
Encoding:
Perl POD Document  |  1999-12-28  |  3.5 KB  |  145 lines
  1. package Getopt::Std;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. =head1 NAME
  6.  
  7. getopt - Process single-character switches with switch clustering
  8.  
  9. getopts - Process single-character switches with switch clustering
  10.  
  11. =head1 SYNOPSIS
  12.  
  13.     use Getopt::Std;
  14.  
  15.     getopt('oDI');    # -o, -D & -I take arg.  Sets opt_* as a side effect.
  16.     getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
  17.     getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
  18.     getopts('oif:', \%opts);  # options as above. Values in %opts
  19.  
  20. =head1 DESCRIPTION
  21.  
  22. The getopt() functions processes single-character switches with switch
  23. clustering.  Pass one argument which is a string containing all switches
  24. that take an argument.  For each switch found, sets $opt_x (where x is the
  25. switch name) to the value of the argument, or 1 if no argument.  Switches
  26. which take an argument don't care whether there is a space between the
  27. switch and the argument.
  28.  
  29. For those of you who don't like additional variables being created, getopt()
  30. and getopts() will also accept a hash reference as an optional second argument. 
  31. Hash keys will be x (where x is the switch name) with key values the value of
  32. the argument or 1 if no argument is specified.
  33.  
  34. =cut
  35.  
  36. @ISA = qw(Exporter);
  37. @EXPORT = qw(getopt getopts);
  38.  
  39.  
  40.  
  41.  
  42. sub getopt ($;$) {
  43.     local($argumentative, $hash) = @_;
  44.     local($_,$first,$rest);
  45.     local $Exporter::ExportLevel;
  46.  
  47.     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  48.     ($first,$rest) = ($1,$2);
  49.     if (index($argumentative,$first) >= 0) {
  50.         if ($rest ne '') {
  51.         shift(@ARGV);
  52.         }
  53.         else {
  54.         shift(@ARGV);
  55.         $rest = shift(@ARGV);
  56.         }
  57.           if (ref $hash) {
  58.               $$hash{$first} = $rest;
  59.           }
  60.           else {
  61.               eval "\$opt_$first = \$rest;";
  62.               push( @EXPORT, "\$opt_$first" );
  63.           }
  64.     }
  65.     else {
  66.           if (ref $hash) {
  67.               $$hash{$first} = 1;
  68.           }
  69.           else {
  70.               eval "\$opt_$first = 1;";
  71.               push( @EXPORT, "\$opt_$first" );
  72.           }
  73.         if ($rest ne '') {
  74.         $ARGV[0] = "-$rest";
  75.         }
  76.         else {
  77.         shift(@ARGV);
  78.         }
  79.     }
  80.     }
  81.     $Exporter::ExportLevel++;
  82.     import Getopt::Std;
  83. }
  84.  
  85.  
  86. sub getopts ($;$) {
  87.     local($argumentative, $hash) = @_;
  88.     local(@args,$_,$first,$rest);
  89.     local($errs) = 0;
  90.     local $Exporter::ExportLevel;
  91.  
  92.     @args = split( / */, $argumentative );
  93.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  94.     ($first,$rest) = ($1,$2);
  95.     $pos = index($argumentative,$first);
  96.     if($pos >= 0) {
  97.         if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
  98.         shift(@ARGV);
  99.         if($rest eq '') {
  100.             ++$errs unless @ARGV;
  101.             $rest = shift(@ARGV);
  102.         }
  103.               if (ref $hash) {
  104.                   $$hash{$first} = $rest;
  105.               }
  106.               else {
  107.                   eval "\$opt_$first = \$rest;";
  108.                   push( @EXPORT, "\$opt_$first" );
  109.               }
  110.         }
  111.         else {
  112.               if (ref $hash) {
  113.                   $$hash{$first} = 1;
  114.               }
  115.               else {
  116.                   eval "\$opt_$first = 1";
  117.                   push( @EXPORT, "\$opt_$first" );
  118.               }
  119.         if($rest eq '') {
  120.             shift(@ARGV);
  121.         }
  122.         else {
  123.             $ARGV[0] = "-$rest";
  124.         }
  125.         }
  126.     }
  127.     else {
  128.         print STDERR "Unknown option: $first\n";
  129.         ++$errs;
  130.         if($rest ne '') {
  131.         $ARGV[0] = "-$rest";
  132.         }
  133.         else {
  134.         shift(@ARGV);
  135.         }
  136.     }
  137.     }
  138.     $Exporter::ExportLevel++;
  139.     import Getopt::Std;
  140.     $errs == 0;
  141. }
  142.  
  143. 1;
  144.  
  145.